home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Programming / Programming Utilities / MacsBug 6.2.2 ƒ / dcmds / Pascal Samples / Heap.p < prev    next >
Encoding:
Text File  |  1990-08-22  |  2.2 KB  |  89 lines  |  [TEXT/ttxt]
  1. UNIT Heap;
  2.  
  3. (* The following MPW commands will build the dcmd and copy it to the
  4.    "Debugger Prefs" file in the System folder. The dcmd's name in
  5.          MacsBug will be the name of the file built by the Linker.
  6.  
  7.         Pascal Heap.p
  8.         Link dcmdGlue.a.o Heap.p.o "{Libraries}Runtime.o" "{PLibraries}PasLib.o" -o Heap
  9.         BuildDcmd Heap 100
  10.                     Echo 'include "Heap";'            |            Rez -a -o "{systemFolder}Debugger Prefs"
  11. *)
  12.  
  13. {$R-}
  14.  
  15. INTERFACE
  16.  
  17.         USES MemTypes, dcmd;
  18.         
  19.   { Public declaration for dcmdGlue. Must be in every dcmd. The name cannot be changed. }
  20.         PROCEDURE CommandEntry (paramPtr: dcmdBlockPtr);
  21.  
  22.  
  23. IMPLEMENTATION
  24.  
  25. PROCEDURE NumberToHex (number: LONGINT; VAR hex: Str255);
  26. VAR digits: Str255;
  27.     n: INTEGER;
  28. BEGIN
  29.   digits := '0123456789ABCDEF';
  30.         hex    := '00000000';
  31.         FOR n := 8 DOWNTO 1 DO
  32.           BEGIN
  33.                 hex[n] := digits[1 + (number MOD 16)];
  34.                 number := number DIV 16;
  35.                 END;
  36. END;
  37.  
  38.  
  39. PROCEDURE DisplayBlockInfo (blockAddress, blockLength, masterPtr: LONGINT; blockType: INTEGER; locked, purgeable, resource: BOOLEAN);
  40. VAR value: Str255;
  41. BEGIN
  42.         NumberToHex (blockAddress, value);
  43.         dcmdDrawLine (value);
  44.  
  45.         NumberToHex (blockLength, value);
  46.         dcmdDrawString (' ');
  47.         dcmdDrawString (value);
  48.  
  49.         IF blockType = relocatableBlock THEN
  50.           BEGIN
  51.                 NumberToHex (masterPtr, value);
  52.                 dcmdDrawString (' ');
  53.                 dcmdDrawString (value);
  54.  
  55.                 dcmdDrawString (' ');
  56.                 IF locked THEN
  57.                         dcmdDrawString ('Locked ');
  58.                 IF purgeable THEN
  59.                         dcmdDrawString ('Purgeable ');
  60.                 IF resource THEN
  61.                         dcmdDrawString ('Resource ');
  62.                 END;
  63. END;
  64.  
  65.  
  66. PROCEDURE CommandEntry (paramPtr: DCmdBlockPtr);
  67. BEGIN
  68.   IF paramPtr^.request = dcmdInit THEN
  69.           BEGIN    { The dcmd gets called once when loaded to init itself }
  70.                 END
  71.         ELSE
  72.   IF paramPtr^.request = dcmdDoIt THEN
  73.           BEGIN { Do the command's normal function }
  74.                 { Draw the column labels }
  75.                 dcmdDrawLine ('  Address   Length  Mstr Ptr');
  76.  
  77.     { The MacsBug heap iterator will call DisplayBlockInfo once for each block in the heap }
  78.                 dcmdForAllHeapBlocks (@DisplayBlockInfo);
  79.                 END
  80.         ELSE
  81.   IF paramPtr^.request = dcmdHelp THEN
  82.           BEGIN { Display the command's help information }
  83.                 dcmdDrawLine ('HEAP');
  84.                 dcmdDrawLine ('   Displays information about all heap blocks');
  85.                 END;
  86. END;
  87.  
  88. END.
  89.